home *** CD-ROM | disk | FTP | other *** search
- {Copyright John O'Connell 1996. All rights reserved}
- unit Bdejoc;
-
- interface
-
- uses
- SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
- Forms, Dialogs, DB, DbiProcs, DbiTypes, DBTables;
-
- type
- TInMemTable = class(TDBDataset)
- private
- { Private declarations }
- FBorrowFrom: TTable;
- protected
- { Protected declarations }
- procedure CheckIsBorrowFromACtive;
- public
- { Public declarations }
- constructor Create(AOwner: TComponent); override;
- function CreateHandle: HDbiCur; override;
- published
- { Published declarations }
- property BorrowFrom: TTable read FBorrowFrom write FBorrowFrom;
- end;
-
- TGenTable = class(TDataSet)
- private
- { Private declarations }
- FHandle: HDbiCur; {overrides inherited handle property}
- procedure SetHandle(const Value: HDbiCur);
- protected
- { Protected declarations }
- public
- { Public declarations }
- function CreateHandle: HDbiCur; override;
- property Handle: HDbiCur read FHandle write SetHandle;
- published
- { Published declarations }
- end;
-
- TTempTable = class(TTable)
- private
- { Private declarations }
- FBorrowFrom: TDataSet;
- FBorrowInd: boolean;
- procedure SetBorrowFromIndex(Value: boolean);
- procedure SetBorrowFrom(Value: TDataset);
- protected
- { Protected declarations }
- procedure CheckIsBorrowFromACtive;
- public
- { Public declarations }
- constructor Create(AOwner: TComponent); override;
- function CreateHandle: HDbiCur; override;
- published
- { Published declarations }
- property BorrowFrom: TDataset read FBorrowFrom write SetBorrowFrom;
- property BorrowIndexes: boolean read FBorrowInd write SetBorrowFromIndex default False;
- end;
-
-
- procedure Register;
-
- implementation
-
- { TInMemTable }
-
- constructor TInMemTable.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- FBorrowFrom := nil;
- end;
-
- function TInMemTable.CreateHandle: HDbiCur;
- var PFieldDescs: Pointer;
- Props: CURProps;
- szTableName: DBITBLNAME;
- begin
- Result := nil;
- PFieldDescs := nil;
- CheckIsBorrowFromActive;
-
- StrPCopy(szTableName, 'INMEMORYTABLE');
- Check(DbiGetCursorProps(FBorrowFrom.Handle, Props));
- try
- PFieldDescs := AllocMem(Props.iFields * sizeof(FLDDesc));
- Check(DbiGetFieldDescs(FBorrowFrom.Handle, PFieldDescs));
- Check(DbiCreateInMemTable(Database.Handle, szTableName, Props.iFields, PFieldDescs, Result));
- finally
- if Assigned(PFieldDescs) then
- FreeMem(PFieldDescs, Props.iFields * sizeof(FLDDesc));
- end;
- end;
-
- procedure TInMemTable.CheckIsBorrowFromActive;
- begin
- if not FBorrowFrom.Active then
- DatabaseError(format('TTable %s is not open', [FBorrowFrom.Name]));
- end;
-
- { TGenTable }
-
- function TGenTable.CreateHandle: HDbiCur;
- begin
- Result := FHandle;
- end;
-
- procedure TGenTable.SetHandle(const Value: HDbiCur);
- begin
- CheckInactive;
- FHandle := Value;
- end;
-
- { TTempTable }
-
- constructor TTempTable.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- FBorrowInd := False;
- end;
-
- procedure TTempTable.SetBorrowFromIndex(Value: boolean);
- begin
- CheckInActive;
- FBorrowInd := Value;
- end;
-
- procedure TTempTable.SetBorrowFrom(Value: TDataSet);
- begin
- CheckInActive;
- if Value = Self then
- Exit;
- if Value.InheritsFrom(TTable) or Value.InheritsFrom(TQuery) then
- FBorrowFrom := Value
- else
- DatabaseError('Can only borrow from TQuery or TTable');
- end;
-
- function TTempTable.CreateHandle: HDbiCur;
- var PFieldDescs: Pointer;
- PIndexDescs: pIDXDesc;
- Props: CURProps;
- TblDesc: CRTblDesc;
- szTableName: DBITBLNAME;
- begin
- Result := nil;
- PFieldDescs := nil;
- PIndexDescs := nil;
-
- CheckIsBorrowFromActive;
-
- FillChar(szTableName, sizeof(DBITBLNAME), 0);
- StrCopy(szTableName, 'TMPTABLE');
- Check(DbiGetCursorProps(FBorrowFrom.Handle, Props));
-
- try
- PFieldDescs := AllocMem(Props.iFields * sizeof(FLDDesc));
- Check(DbiGetFieldDescs(FBorrowFrom.Handle, PFieldDescs));
-
- FillChar(TblDesc, sizeof(CRTblDesc), 0);
- with TblDesc do
- begin
- StrCopy(szTblName, szTableName);
- {StrCopy(szTblName, Props.szName);}
- StrCopy(szTblType, Props.szTableType);
- iFldCount := Props.iFields;
- pfldDesc := PFieldDescs;
- iIdxCount := Props.iIndexes;
-
- if FBorrowInd and (iIdxCount > 0) then
- begin
- PIndexDescs := AllocMem(Props.iIndexes * sizeof(IDXDesc));
- {$IFDEF Win32}
- Check(DbiGetIndexDescs(FBorrowFrom.Handle, PIndexDescs));
- {$ELSE}
- Check(DbiGetIndexDescs(FBorrowFrom.Handle, PIndexDescs^));
- {$ENDIF}
- pidxDesc := PIndexDescs;
- end
- else
- iIdxCount := 0;
- end;
-
- Check(DbiCreateTempTable(Database.Handle, TblDesc, Result));
- Check(DbiSetProp(HDBIObj(Result), curXLTMODE, LongInt(xltFIELD)));
- finally
- if Assigned(PIndexDescs) then
- FreeMem(PIndexDescs, Props.iIndexes * sizeof(IDXDesc));
- if Assigned(PFieldDescs) then
- FreeMem(PFieldDescs, Props.iFields * sizeof(FLDDesc));
- end;
- end;
-
- procedure TTempTable.CheckIsBorrowFromActive;
- begin
- if not FBorrowFrom.Active then
- DatabaseError(format('Dataset %s is not open', [FBorrowFrom.Name]));
- end;
-
- procedure Register;
- begin
- RegisterComponents('JOC', [TInMemTable, TGenTable, TTempTable]);
- end;
-
- end.
-